unit MMDBRegistry;

interface

uses Registry, Dialogs, Sysutils, Forms, Graphics, WinAPI.Windows;

const
  csfsBold      = '|Bold';
  csfsItalic    = '|Italic';
  csfsUnderline = '|Underline';
  csfsStrikeout = '|Strikeout';

type TdbReg = class
  public
    DocCtrlPath: string;   //path to document control
    KitsPath: string;   //path to doc control Kits directory
    NetCDSPath: string;      //path to master data set file
    LocalCDSPath: string;   //path to local copy of data set file
    Font: TFont;
    procedure RegLoad;
    procedure RegSave;
    procedure StringToFont(sFont : string);// Font : TFont );
    function FontToString: string;
end;

implementation

(***************************************************************************
RegLoad(): Load registry values into dbReg object for use throughout the
           session.
*******************************************************************************)
procedure TdbReg.RegLoad;
var
  RegTemp: TRegistry;
  str: string;
begin
  RegTemp := TRegistry.Create; //Create registry object
try
  with RegTemp do
  begin
    if not (KeyExists('Software\Merit\MMDBV2.1')) then //See if key exists
      OpenKey('Software\Merit\MMDBV2.1',True) //Create and open  key
      else
      OpenKey('Software\Merit\MMDBV2.1', False); //Sets current key
      {Create and initialize values if they do not exist.}
      if not (ValueExists('VERSION')) then
        begin
         WriteString('VERSION','V2.0');  //allows registry to be updated when
                                        //new versions are released.
         WriteString('DOCCTRLPATH', '\\merit.com\sj_doc\DOC');
         WriteString('KITSPATH', '\\merit.com\sj_doc\KITS\DCKITS');
         WriteString('NETCDSPATH', '\\merit.com\sj_public\PUBLIC\DocBrowser\MMDBV2_1');
         WriteString('LOCALCDSPATH', ExtractFilePath(Application.ExeName));
         WriteInteger('GRIDFONTCHARSET', DEFAULT_CHARSET);
         WriteString('GRIDFONT', '"Tahoma", -13, [], [clWindowText]');
        end
        else
         begin
          if not (ValueExists('VERSION')) then
           WriteString('VERSION','V2.0');
          if not (ValueExists('DOCCTRLPATH')) then
           WriteString('DOCCTRLPATH', '\\merit.com\sj_doc\DOC');
          if not (ValueExists('KITSPATH')) then
           WriteString('KITSPATH', '\\merit.com\sj_doc\KITS\DCKITS');
          if not (ValueExists('NETCDSPATH')) then
           WriteString('NETCDSPATH', '\\merit.com\sj_public\PUBLIC\DocBrowser\MMDBV2_1');
          if not (ValueExists('LOCALCDSPATH')) then
           WriteString('LOCALCDSPATH', ExtractFilePath(Application.ExeName));
          if not (ValueExists('GRIDFONTCHARSET')) then
            WriteInteger('GRIDFONTCHARSET', DEFAULT_CHARSET);
          if not (ValueExists('GRIDFONT')) then
            WriteString('GRIDFONT', '"Tahoma", -13, [], [clWindowText]');
         end;
      {Initialize TdbReg class member values from registry.}
      DocCtrlPath := ReadString('DOCCTRLPATH');
      KitsPath := ReadString('KITSPATH');
      NetCDSPath := ReadString('NETCDSPATH');
      LocalCDSPath := ReadString('LOCALCDSPATH');
      Font.Charset := ReadInteger('GRIDFONTCHARSET');
      StringToFont(ReadString('GRIDFONT'));  //get the font info

  end;     //end with statement
  except
    //ShowMessage('Unable to access registry. Switching' +#13 +
    //            'to default values.');
    DocCtrlPath := '\\merit.com\sj_doc\DOC';
    KitsPath := '\\merit.com\sj_doc\KITS\DCKITS';
    NetCDSPath := 'merit.com\sj_public\PUBLIC\DocBrowser\MMDBV2_1';
    LocalCDSPath := ExtractFilePath(Application.ExeName);
    //May need to add Font info here, but assume app defaults will be used.
  end;
  RegTemp.Free;
end;

(***************************************************************************
RegSave(): Save dbReg values back to the registry.
*******************************************************************************)
procedure TdbReg.RegSave;
var
  RegTemp: TRegistry;
begin
  RegTemp := TRegistry.Create; //Create registry object
  with RegTemp do
  begin
   try
     OpenKey('Software\Merit\MMDBV2.1', False); //Sets current key
     WriteString('DOCCTRLPATH', DocCtrlPath);
     WriteString('KITSPATH', KitsPath);
     WriteString('NETCDSPATH', NetCDSPath);
     WriteString('LOCALCDSPATH', LocalCDSPath);
     WriteInteger('GRIDFONTCHARSET', DEFAULT_CHARSET);
     WriteString('GRIDFONT', FontToString);
   except
    ShowMessage('Unable to save values to registry. '+#13 +
                'Default values will be loaded on next run.');
   end;
  end;   //end with
  RegTemp.Free;
end;



(***************************************************************************
StringToFont(): Convert a string from registry to a font so that it can be
                read and used in the application.
*******************************************************************************)
// Expected format:
//   "Arial", 9, [Bold], [clRed]
//
procedure TdbReg.StringToFont(sFont : string);
var
  p      : integer;
  sStyle : string;
begin
  with Font do
  begin
    // get font name
    p    := Pos( ',', sFont );
    Name :=
      Copy( sFont, 2, p-3 );
    Delete( sFont, 1, p );

    // get font size
    p    := Pos( ',', sFont );
    Size :=
      StrToInt( Copy( sFont, 2, p-2 ) );
    Delete( sFont, 1, p );

    // get font style
    p      := Pos( ',', sFont );
    sStyle :=
      '|' + Copy( sFont, 3, p-4 );
    Delete( sFont, 1, p );

    // get font color
    Color :=
      StringToColor(
        Copy( sFont, 3,
          Length( sFont ) - 3 ) );

    // convert str font style to
    // font style
    Style := [];

    if( Pos( csfsBold,
          sStyle ) > 0 )then
      Style := Style + [ fsBold ];

    if( Pos( csfsItalic,
          sStyle ) > 0 )then
      Style := Style + [ fsItalic ];

    if( Pos( csfsUnderline,
          sStyle ) > 0 )then
      Style := Style + [ fsUnderline ];

    if( Pos( csfsStrikeout,
          sStyle ) > 0 )then
      Style := Style + [ fsStrikeout ];
  end;
end;

//
// Output format:
//   "Aril", 9, [Bold|Italic], [clAqua]
//
(***************************************************************************
FontToString(): Convert a font to a string so that it can be
               saved to the registry.
*******************************************************************************)
function TdbReg.FontToString: string;
var
  sStyle : string;
begin
  with Font do
  begin
    // convert font style to string
    sStyle := '';

    if( fsBold in Style )then
      sStyle := sStyle + csfsBold;

    if( fsItalic in Style )then
      sStyle := sStyle + csfsItalic;

    if( fsUnderline in Style )then
      sStyle := sStyle + csfsUnderline;

    if( fsStrikeout in Style )then
      sStyle := sStyle + csfsStrikeout;

    if( ( Length( sStyle ) > 0 ) and
        ( '|' = sStyle[ 1 ] ) )then
    begin
      sStyle :=
        Copy( sStyle, 2,
          Length( sStyle ) - 1 );
    end;

    Result := Format(
      '"%s", %d, [%s], [%s]',
      [ Name,
        Size,
        sStyle,
        ColorToString( Color ) ] );
  end;
end;

end.

